home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / tst / towers-of-hanoi.tst < prev    next >
Text File  |  1992-05-19  |  972b  |  59 lines
  1. .( Loading Towers of Hanoi benchmark...) cr
  2.  
  3. \ The classical Towers of Hanoi benchmark
  4. \
  5. \ From W.P. Salman, O. Tisserand and B. Toulout, FORTH, Macmillan
  6. \ pp. 120-121
  7.  
  8. variable moves
  9.  
  10. : copy ( x y z -- x y z x y z)
  11.   >r 2dup r@ -rot r>
  12. ;
  13.  
  14. : dispose ( x y z -- )
  15.   2drop drop
  16. ;
  17.  
  18. : edit ( d a n -- d a n)
  19.   copy drop swap ." From: " . ." to: " . cr
  20. ;
  21.  
  22. : prepare-call ( d a n -- d a n d i n-1)
  23.   copy -rot over + 6 swap - rot 1-
  24. ;
  25.  
  26. : prepare-return ( d a n -- d a n i a n-1)
  27.   copy swap rot over + 6 swap - swap rot 1-
  28. ;
  29.  
  30. : verify-hanoi ( departure arrival number -- )
  31.   dup
  32.   if prepare-call recurse
  33.     edit
  34.     prepare-return recurse
  35.   then
  36.   dispose
  37. ;
  38.  
  39. : verify-towers-of-hanoi ( -- )
  40.   1 3 4 verify-hanoi
  41. ;
  42.  
  43. : hanoi ( departure arrival number -- )
  44.   dup
  45.   if prepare-call recurse
  46.     1 moves +!
  47.     prepare-return recurse
  48.   then
  49.   dispose
  50. ;
  51.  
  52. : towers-of-hanoi ( -- )
  53.   0 moves !
  54.   1 3 14 hanoi
  55.   moves @ 16383 = not abort" towers-of-hanoi: wrong result"
  56. ;
  57.  
  58. forth only
  59.